home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 February: Tool Chest / Dev.CD Feb 95 / Dev.CD Feb 95.toast / Tool Chest / Development Tools & Languages / Dylan Related / Mindy-1.1 (sources only) / mindy-1.1 / elisp / dylan-mode.el next >
Encoding:
Text File  |  1994-08-25  |  33.4 KB  |  848 lines  |  [TEXT/ttxt]
  1. ;;; dylan-mode.el Implements indentation and basic support for Dylan (tm)
  2. ;;; programs.
  3.  
  4. ;;; Copyright (C) 1994  Carnegie Mellon University
  5. ;;;
  6. ;;; Bug reports, questions, comments, and suggestions should be sent by
  7. ;;; E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  8. ;;;
  9. ;;; Author: Robert Stockton (rgs@cs.cmu.edu)
  10. ;;;
  11. ;;; This program is free software; you can redistribute it and/or modify
  12. ;;; it under the terms of the GNU General Public License as published by
  13. ;;; the Free Software Foundation; either version 1, or (at your option)
  14. ;;; any later version.
  15. ;;;
  16. ;;; This program is distributed in the hope that it will be useful,
  17. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;;; GNU General Public License for more details.
  20. ;;;
  21. ;;; A copy of the GNU General Public License can be obtained from this
  22. ;;; program's author (send electronic mail to "gwydion-bugs@cs.cmu.edu")
  23. ;;; or from the Free Software Foundation, Inc., 675 Mass Ave,
  24. ;;; Cambridge, MA 02139, USA.
  25.  
  26. ;;; User modifiable variables
  27. (defvar dylan-indent 2
  28.   "* Number of spaces to indent each sub-block.")
  29. (defvar dylan-outdent-arrows t
  30.   "* Should '=>' in function definitions be treated specially?")
  31.  
  32. ;;; Version 1.0
  33. ;;; History:
  34. ;;;   version 0.1: Quick one day hack -- appears to be useful
  35. ;;;   version 0.2: Added font lock support
  36. ;;;   version 0.3: Added misc features to work towards "industrial strength"
  37. ;;;     Detects "continuation lines" and indents them specially
  38. ;;;     Basic comment support
  39. ;;;     Added "symbol character" support (with second syntax table for
  40. ;;;     indentation and font-lock)
  41. ;;;     Added indentation support for "elseif" and "exception" clauses
  42. ;;;     Cleaned up a number of old bugs
  43. ;;;   version 0.4: Brought into compliance with new "post-DN22" syntax
  44. ;;;     new comment syntax
  45. ;;;     new "return types" syntax
  46. ;;;     accepts sealed, open, concrete, and abstract in class definitions
  47. ;;;     fixed bug in comment indentation
  48. ;;;     fine tune font-lock-regexps for "define ..."
  49. ;;;   version 0.5:
  50. ;;;     Added "dylan-insert-block-end" function.
  51. ;;;     Fixed bug in short circuiting indentation outside top level forms.
  52. ;;;   version 1.0:
  53. ;;;     Major code reorganization
  54. ;;;     Added full case statement support
  55. ;;;     Fixed "continuations" at top level
  56. ;;;     Added "beginning-of-form" and "end-of-form" commands
  57. ;;;     Fixed support for character literals and for "quoted" quote chars
  58. ;;;   version 1.1:
  59. ;;;     The "font-lock-mode" support no longer interferes with other language
  60. ;;;     modes.   (Thanks to emg@hip.atr.co.jp)
  61. ;;;   version 1.2:
  62. ;;;     Fixes for various bugs (thanks to wlott@cs.cmu.edu):
  63. ;;;       "foo-end;" was mistaken for the end of a compound statement
  64. ;;;       syntax tables sometimes ended in an odd state after errors
  65. ;;;       indentation sometimes failed if parens weren't balanced
  66. ;;;   version 1.3:
  67. ;;;     Added font lock support for "sealed", "open", etc.
  68. ;;;   version 1.4:
  69. ;;;     Added special-case support for generic function "continuations" and
  70. ;;;     for outdenting "=>" in function definitions.
  71. ;;;   version 1.5:
  72. ;;;     Adjusted regexps to accept "primary" and "free" adjectives
  73. ;;;     Mentioned dylan-outdent-arrows in the documentation
  74. ;;;     Added a space to comment-start
  75. ;;;   version 1.6:
  76. ;;;     Fixed bug in generic function continuations from 1.4.
  77.  
  78. ;;; Known limitations:
  79. ;;;   Limited support for block (i.e. "/*") comments
  80. ;;;   Indentation for lines inside "{}" blocks is wrong
  81. ;;;   font-lock-mode should italicize the function in "block (return)" -- phg
  82.  
  83. ;;; Desired features:
  84. ;;;   Copy indentation from first statement in body
  85. ;;;   Beginning of defun and end of defun
  86. ;;;   Delete-backward-expanding-tabs
  87.  
  88. ;;; Private definitions
  89. (defvar dyl-start-keywords
  90.   '("if" "define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t]+method"
  91.     "define\\([ \t]+\\(sealed\\|open\\|abstract\\|concrete\\|primary\\|free\\)\\)*[ \t]+class"
  92.     "define[ \t]+library" "define[ \t]+module"
  93.     "block" "begin" "method"
  94.     "case" "for" "select" "unless" "until" "while")
  95.   "Patterns that signal the start of a nested 'body'.")
  96.  
  97. (defvar dyl-start-expressions
  98.   '(("if[ \t\n]*" "")
  99.     ("\\(define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t\n]+\\)?method[ \t\n]+[^\( ]*[ \t\n]*" "[ \t\n]*=>[^;]+;")
  100.     ("\\(define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t\n]+\\)?method[ \t\n]+[^\( ]*[ \t\n]*" "[ \t\n]*;")
  101.     ("\\(define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t\n]+\\)?method[ \t\n]+[^\( ]*[ \t\n]*" "")
  102.     ("define\\([ \t\n]+\\(sealed\\|open\\|abstract\\|concrete\\|primary\\|free\\)\\)*[ \t\n]+class[ \t\n]+[^\( ]+[ \t\n]*" "")
  103.     ("block[ \t\n]*" "")
  104.     ("for[ \t\n]*" "")
  105.     ("select[ \t\n]*" "")
  106.     ("unless[ \t\n]*" "")
  107.     ("until[ \t\n]*" "")
  108.     ("while[ \t\n]*" "")
  109.     "define[ \t\n]+library[ \t\n]+[^ \t\n]+"
  110.     "define[ \t\n]+module[ \t\n]+[^ \t\n]+"
  111.     "begin" "case" "(")
  112.   "Patterns which match that portion of a 'compound statement' which precedes
  113. the 'body'.  This is used to determine where the first statement 
  114. begins for indentation purposes.  
  115.  
  116. Contains a list of patterns, each of which is either a regular 
  117. expression or a list of regular expressions.  A set of balanced 
  118. parens will be matched between each list element.")
  119.  
  120. (defvar dyl-end-keywords
  121.   '("end[ \t]+if" "end[ \t]+method" "end[ \t]+class" "end[ \t]+library"
  122.     "end[ \t]+module" "end[ \t]+block"
  123.     "end[ \t]+case" "end[ \t]+select" "end[ \t]+for" "end[ \t]+unless"
  124.     "end[ \t]+until" "end[ \t]+while" "end")
  125.   "Patterns which end a compound statement.")
  126.  
  127. (defvar dyl-separator-keywords
  128.   '("finally" "exception" "cleanup" "else" "elseif")
  129.   "Patterns act as separators in compound statements.  This may include any
  130. general pattern which must be indented specially.")
  131.  
  132. (defvar dyl-other-keywords
  133.   '("above" "below" "by" "define[ \t]+constant" "define[ \t]+variable" "from"
  134.     "define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t]+generic"
  135.     "handler" "in" "instance" "let" "local" "otherwise"
  136.     "slot" "subclass" "then" "to" "virtual")
  137.   "Keywords which do not require special indentation handling, but which
  138. should be highlighted if this capability exists.")
  139.  
  140. (defvar dylan-mode-map ()
  141.   "Keymap used in dylan mode.")
  142. (if (not dylan-mode-map)
  143.     (progn
  144.       (setq dylan-mode-map (make-sparse-keymap))
  145.       (define-key dylan-mode-map ";" 'dylan-insert-and-indent)
  146.       (define-key dylan-mode-map "," 'dylan-insert-and-indent)
  147.       (define-key dylan-mode-map ">" 'dylan-arrow-insert)
  148.       (define-key dylan-mode-map "\n" 'dylan-newline-and-indent)
  149.       (define-key dylan-mode-map "\t" 'dylan-indent-line)
  150.       (define-key dylan-mode-map "\ea" 'dylan-beginning-of-form)
  151.       (define-key dylan-mode-map "\ee" 'dylan-end-of-form)
  152.       (define-key dylan-mode-map "\e)" 'dylan-insert-block-end)))
  153.  
  154. (defvar dylan-mode-abbrev-table nil
  155.   "Abbrev table in use in dylan-mode buffers.  Provides 'hooked' 
  156. abbreviations to reindent lines containing 'separator' keywords.")
  157. (if (not dylan-mode-abbrev-table)
  158.     (progn
  159.      (define-abbrev-table 'dylan-mode-abbrev-table ())
  160.      (define-abbrev dylan-mode-abbrev-table "end" "end" 'reindent-line)
  161.      (let ((list dyl-separator-keywords))
  162.        (while list
  163.      (define-abbrev dylan-mode-abbrev-table
  164.        (car list) (car list) 'reindent-line)
  165.      (setq list (cdr list))))))
  166.  
  167. (defvar dylan-mode-syntax-table nil
  168.   "User level syntax table.  Provides support for forward-word, etc.")
  169. (defvar dylan-indent-syntax-table nil
  170.   "Special syntax table which is used by the indent and font-lock code 
  171. for finding keywords and the like.  This is necessary because there is
  172. no equivalent to '\b' for identifiers.")
  173.  
  174. (if (not dylan-mode-syntax-table)
  175.     (progn
  176.       (setq dylan-mode-syntax-table (make-syntax-table))
  177.       (modify-syntax-entry ?_ "_" dylan-mode-syntax-table)
  178.       (modify-syntax-entry ?- "_" dylan-mode-syntax-table)
  179.       (modify-syntax-entry ?< "_" dylan-mode-syntax-table)
  180.       (modify-syntax-entry ?> "_" dylan-mode-syntax-table)
  181.       (modify-syntax-entry ?? "_" dylan-mode-syntax-table)
  182.       (modify-syntax-entry ?! "_" dylan-mode-syntax-table)
  183.       (modify-syntax-entry ?= "_" dylan-mode-syntax-table)
  184.       (modify-syntax-entry ?: "_" dylan-mode-syntax-table)
  185.       (modify-syntax-entry ?' "\"" dylan-mode-syntax-table)
  186.       (modify-syntax-entry ?\f " " dylan-mode-syntax-table)
  187.       ; different emacs version handle comments differently
  188.       (cond ((and (boundp 'running-lemacs) running-lemacs)
  189.          (modify-syntax-entry ?\n "> b" dylan-mode-syntax-table)
  190.          (modify-syntax-entry ?/ "_ 1456" dylan-mode-syntax-table)
  191.          (modify-syntax-entry ?\* "_ 23" dylan-mode-syntax-table))
  192.         ((string-lessp emacs-version "19")
  193.          ; emacs 18 doesn't have sufficient support to grok "//" comments
  194.          ; so we must (regretfully) leave them out
  195.          (modify-syntax-entry ?/ "_ 14" dylan-mode-syntax-table)
  196.          (modify-syntax-entry ?\* "_ 23" dylan-mode-syntax-table))
  197.         (t
  198.          (modify-syntax-entry ?\n "> b" dylan-mode-syntax-table)
  199.          (modify-syntax-entry ?/ "_ 1456b2" dylan-mode-syntax-table)
  200.          (modify-syntax-entry ?\* "_ 23" dylan-mode-syntax-table)))
  201.       (setq dylan-indent-syntax-table
  202.         (copy-syntax-table dylan-mode-syntax-table))
  203.       (modify-syntax-entry ?_ "w" dylan-indent-syntax-table)
  204.       (modify-syntax-entry ?- "w" dylan-indent-syntax-table)
  205.       (modify-syntax-entry ?/ "w 1456" dylan-mode-syntax-table)
  206.       (modify-syntax-entry ?\* "w 23" dylan-mode-syntax-table)
  207.       (modify-syntax-entry ?< "w" dylan-indent-syntax-table)
  208.       (modify-syntax-entry ?> "w" dylan-indent-syntax-table)
  209.       (modify-syntax-entry ?? "w" dylan-indent-syntax-table)
  210.       (modify-syntax-entry ?! "w" dylan-indent-syntax-table)
  211.       (modify-syntax-entry ?= "w" dylan-indent-syntax-table)
  212.       (modify-syntax-entry ?: "w" dylan-indent-syntax-table)))
  213.  
  214. ;;; Ugly code which you don't want to look at.
  215. (defvar dylan-comment-pattern "//.*$"
  216.   "Internal pattern for finding comments in dylan code.  Currently only
  217. handles end-of-line comments.")
  218.  
  219. (defun make-pattern (start &rest list)
  220.   "Builds a search pattern that matches any of the patterns passed to it.
  221. Makes sure that it doesn't match partial words."
  222.   (let ((str (concat "\\b" start "\\b")))
  223.     (while list
  224.       (setq str (concat str "\\|\\b" (car list) "\\b"))
  225.       (setq list (cdr list)))
  226.     str))
  227.  
  228. (defvar dyl-keyword-pattern (apply 'make-pattern dyl-start-keywords))
  229. (defvar dyl-end-keyword-pattern (apply 'make-pattern dyl-end-keywords))
  230. (defvar separator-word-pattern (apply 'make-pattern dyl-separator-keywords))
  231. (defvar dyl-other-pattern (apply 'make-pattern dyl-other-keywords))
  232.  
  233. (defun look-back (regexp)
  234.   "Attempts to find a match for \"regexp\" immediately preceding the current
  235. point.  In order for this to work properly, the search string must end with
  236. '$'.  Also note that this will only work within the current line."
  237.   (save-excursion
  238.     (save-restriction
  239.       (let ((dot (point)))
  240.     (beginning-of-line)
  241.     (narrow-to-region dot (point))
  242.     (re-search-forward regexp nil t)))))
  243.  
  244. (defvar find-keyword-pattern (concat "[][)(}{\"']\\|\\bdefine\\b\\|"
  245.                      dyl-end-keyword-pattern 
  246.                      "\\|" dyl-keyword-pattern)
  247.   "A pattern which matches the beginnings and ends of various 'blocks',
  248. including parenthesized expressions.")
  249.  
  250. (defvar dylan-beginning-of-form-pattern (concat "[;,]\\|=>\\|" find-keyword-pattern
  251.                     "\\|" separator-word-pattern)
  252.   "Like 'find-keyword-pattern' but matches statement terminators as well.")
  253.  
  254. (defun dylan-find-keyword (&optional match-statement-end in-case no-commas)
  255.   "Moves the point backward to the beginning of the innermost enclosing
  256. 'compound statement' or set of parentheses.  Returns t on success and
  257. nil otherwise."
  258.   (if (re-search-backward (if match-statement-end
  259.                  dylan-beginning-of-form-pattern
  260.                find-keyword-pattern) nil t)
  261.       (cond ((look-back dylan-comment-pattern)
  262.          (goto-char (match-beginning 0))
  263.          (dylan-find-keyword match-statement-end in-case no-commas))
  264.         ((looking-at "[])}'\"]")
  265.          (condition-case nil
  266.          (progn 
  267.            (forward-char 1)
  268.            (backward-sexp 1)
  269.            (dylan-find-keyword match-statement-end in-case no-commas))
  270.            (error nil)))
  271.         ((and (looking-at "define")    ; non-nesting top level form
  272.           (not (looking-at dyl-keyword-pattern)))
  273.          nil)
  274.         ((or (looking-at "end")
  275.          (and (look-back "\\bend[ \t]+$") (backward-word 1)))
  276.          (dylan-find-keyword)
  277.          (if (or (and (looking-at "method") (look-back "define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t]+$"))
  278.              (looking-at "define"))
  279.          nil
  280.            (dylan-find-keyword match-statement-end in-case no-commas)))
  281.         ; hack for overloaded uses of "while" and "until" reserved words
  282.         ((or (looking-at "until") (looking-at "while"))
  283.          (if (save-excursion
  284.            (condition-case nil
  285.                (progn 
  286.              (backward-up-list 1)
  287.              (backward-sexp 1)
  288.              (looking-at "for\\b")) (error nil)))
  289.          (backward-up-list 1))
  290.          t)
  291.         ((and (looking-at separator-word-pattern)
  292.           (not match-statement-end))
  293.          (dylan-find-keyword match-statement-end in-case no-commas))
  294.         ((and (looking-at ";") (not match-statement-end))
  295.          (dylan-find-keyword match-statement-end in-case no-commas))
  296.         ((and (looking-at ",") (or (not match-statement-end) no-commas))
  297.          (dylan-find-keyword match-statement-end in-case no-commas))
  298.         ((and (looking-at "=>") (not (and match-statement-end in-case)))
  299.          (dylan-find-keyword match-statement-end in-case no-commas))
  300.         (t t))
  301.     (goto-char (point-min))
  302.     nil))
  303.  
  304. (defun dylan-find-end (&optional match-statement-end in-case no-commas)
  305.   "Moves the point forward to the end of the innermost enclosing
  306. 'compound statement' or set of parentheses.  Returns t on success and
  307. nil otherwise."
  308.   (if (re-search-forward (if match-statement-end
  309.                  dylan-beginning-of-form-pattern
  310.                find-keyword-pattern) nil t)
  311.       (let ((match-start (match-beginning 0)))
  312.     (cond ((look-back dylan-comment-pattern)
  313.            (forward-line)
  314.            (dylan-find-end match-statement-end in-case no-commas))
  315.           ((look-back "[[({'\"]$")
  316.            (condition-case nil
  317.            (progn 
  318.              (backward-char 1)
  319.              (forward-sexp 1)
  320.              (dylan-find-end match-statement-end in-case no-commas))
  321.          (error nil)))
  322.           ((look-back "[])}]$") t)
  323.           ((look-back "define$")    ; special case for top-level forms
  324.            (dylan-find-end t nil nil)
  325.            nil)
  326.           ((look-back "\\bend\\([ \t]+\\w+\\)?$")
  327.            (if (and (not (looking-at "[ \t]+\\(end\\|=>\\)\\b"))
  328.             (looking-at "[ \t]+\\w+"))
  329.            (goto-char (match-end 0)))
  330.            t)
  331.           ; hack for overloaded uses of "while" and "until" reserved words
  332.           ((look-back "until$\\|while$")
  333.            (if (save-excursion
  334.              (condition-case nil
  335.              (progn 
  336.                (backward-up-list 1)
  337.                (backward-sexp 1)
  338.                (looking-at "for\\b")) (error nil)))
  339.            (up-list 1))
  340.            t)
  341.           ((save-excursion (goto-char match-start)
  342.                    (looking-at separator-word-pattern))
  343.            t)
  344.           ((look-back ";$")
  345.            (if (not match-statement-end)
  346.            (dylan-find-end match-statement-end in-case no-commas)
  347.          t))
  348.           ((look-back ",$")
  349.            (if (or (not match-statement-end) no-commas)
  350.            (dylan-find-end match-statement-end in-case no-commas)
  351.          t))
  352.           ((look-back "=>$")
  353.            (if (not (and match-statement-end in-case))
  354.            (dylan-find-end match-statement-end in-case no-commas)
  355.          t))
  356.           (t                ; start compound statement
  357.            (if (save-excursion (goto-char match-start)
  358.                    (looking-at "define"))
  359.            (progn (dylan-find-end) nil)
  360.          (dylan-find-end)
  361.          (dylan-find-end match-statement-end in-case no-commas)))))
  362.     (goto-char (point-max))
  363.     nil))
  364.  
  365. (defun dylan-skip-star-comment-backward ()
  366.   "Utility function for 'dylan-skip-whitespace-backward'.  Finds beginning
  367. of enclosing '/*' comment.  Deals properly with nested '/*' and with '//'."
  368.   (re-search-backward "/\\*\\|\\*/")
  369.   (while (cond ((look-back dylan-comment-pattern)
  370.         (goto-char (match-beginning 0)))
  371.            ((looking-at "\\*/")
  372.         (dylan-skip-star-comment-backward))
  373.            (t nil))
  374.     (re-search-backward "/\\*\\|\\*/"))
  375.   t)
  376.  
  377. (defun dylan-skip-star-comment-forward ()
  378.   "Utility function for 'dylan-skip-whitespace-forward'.  Finds end
  379. of enclosing '/*' comment.  Deals properly with nested '/*' and with '//'."
  380.   (re-search-forward "/\\*\\|\\*/")
  381.   (while (cond ((look-back dylan-comment-pattern)
  382.         (end-of-line))
  383.            ((look-back "/\\*$")
  384.         (dylan-skip-star-comment-forward))
  385.            (t nil))
  386.     (re-search-forward "/\\*\\|\\*/"))
  387.   t)
  388.  
  389. (defvar non-whitespace-string "\\s_\\|\\s(\\|\\s\"\\|\\s$\\|\\s<\\|\\s/\\|\\sw\\|\\s.\\|\\s)\\|\\s'\\|\\s\\"
  390.   "A magic search string which matches everything but 'whitespace'.  Used
  391. because old version of emacs don't have 'skip-syntax-backward'.")
  392.  
  393. (defun dylan-skip-whitespace-backward ()
  394.   "Skips over both varieties of comments and other whitespace characters."
  395.   ; skip syntactic whitespace
  396.   (if (re-search-backward non-whitespace-string nil t)
  397.       (forward-char)
  398.     (goto-char 0))
  399.   ; skip comments
  400.   (while (cond ((look-back dylan-comment-pattern)
  401.         (goto-char (match-beginning 0)))
  402.            ((look-back "\\*/$")
  403.         (goto-char (match-beginning 0))
  404.         (dylan-skip-star-comment-backward))
  405.            (t nil))
  406.     (if (re-search-backward non-whitespace-string nil t)
  407.     (forward-char)
  408.       (goto-char 0))))
  409.  
  410. (defun dylan-skip-whitespace-forward ()
  411.   "Skips over both varieties of comments and other whitespace characters."
  412.   ; skip syntactic whitespace
  413.   (re-search-forward "\\(\\s \\|\\s>\\)*")
  414.   ; skip comments
  415.   (while (cond ((looking-at dylan-comment-pattern)
  416.         (goto-char (match-end 0))
  417.         t)
  418.            ((looking-at "/\\*")
  419.         (goto-char (match-end 0))
  420.         (dylan-skip-star-comment-forward))
  421.            (t nil))
  422.     (re-search-forward "\\(\\s \\|\\s>\\)*")))
  423.  
  424. (defun aux-find-body-start (clauses)
  425.   "Helper function for 'find-body-start'"
  426.   (save-excursion
  427.     (cond ((null clauses) (point))
  428.       ((looking-at (car clauses))
  429.        (if (null (cdr clauses))
  430.            (match-end 0)
  431.          (goto-char (match-end 0))
  432.          (and (looking-at "[[({]")
  433.           (condition-case nil (forward-list) (error nil))
  434.           (aux-find-body-start (cdr clauses))))))))
  435.  
  436. (defun find-body-start (exprs)
  437.   "When passed 'dyl-start-expressions', processes it to find the beginning
  438. of the first statment in the compound statement which starts at the 
  439. current point."
  440.   (cond ((null exprs) (point-max))
  441.     ((listp (car exprs))
  442.      (or (aux-find-body-start (car exprs)) (find-body-start (cdr exprs))))
  443.     (t (if (looking-at (car exprs))
  444.            (match-end 0)
  445.          (find-body-start (cdr exprs))))))
  446.  
  447. (defun backward-dylan-statement (&optional in-case no-commas)
  448.   "Moves the cursor to some undefined point between the previous 'statement'
  449. and the current one.  If we are already between statements, move back one 
  450. more."
  451.   (unwind-protect
  452.       ;; Because "\b" doesn't work with "symbol-chars" we temporarily
  453.       ;; install a new syntax table and restore the old one when done
  454.       (progn
  455.     (set-syntax-table dylan-indent-syntax-table)
  456.     (dylan-skip-whitespace-backward)
  457.     (let* ((dot (point)))
  458.       ;; skip over "separator words"
  459.       (if (save-excursion
  460.         (and (re-search-backward separator-word-pattern nil t)
  461.              (if (not (looking-at "exception\\|elseif"))
  462.              (forward-word 1)
  463.                (goto-char (match-end 0))
  464.                (condition-case nil (forward-list 1)
  465.              (error nil))
  466.                t)
  467.              (>= (point) dot)))
  468.           (progn (re-search-backward separator-word-pattern nil t)
  469.              (dylan-skip-whitespace-backward)))
  470.       (if (look-back "[,;]$\\|=>$")
  471.           (backward-char))
  472.       (cond ((not (dylan-find-keyword t in-case no-commas))
  473.          (if (look-back "\\(define\\|local\\)[ \t]+")    ; hack
  474.              (goto-char (match-beginning 0))))
  475.         ((looking-at separator-word-pattern)
  476.          (let ((start (point)))
  477.            (cond ((looking-at "\\(exception\\|elseif\\)[ \t\n]*(")
  478.               (goto-char (match-end 1))
  479.               (condition-case nil (forward-list 1)
  480.                 (error nil)))
  481.              (t (forward-word 1)))
  482.            (if (>= (point) dot)
  483.                (progn (goto-char start)
  484.                   (backward-dylan-statement in-case no-commas)))))
  485.         ((looking-at "[;,]\\|=>")
  486.          (goto-char (match-end 0)))
  487.         (t
  488.          ;; check whether we were already at the first "form" in an
  489.          ;; enclosing block
  490.          (let ((first (find-body-start dyl-start-expressions)))
  491.            (if (< first dot)
  492.                (goto-char first)
  493.              (if (look-back "\\(define\\|local\\)[ \t]+")    ; hack
  494.              (goto-char (match-beginning 0)))))))))
  495.     (set-syntax-table dylan-mode-syntax-table)))
  496.  
  497. (defun dylan-beginning-of-form ()
  498.   "Finds the beginning of the innermost 'statement' which contains or
  499. terminates at the current point."
  500.   (interactive)
  501.   (backward-dylan-statement)
  502.   (dylan-skip-whitespace-forward))
  503.  
  504. (defun forward-dylan-statement (&optional in-case no-commas)
  505.   "Moves the cursor to some undefined point between the current 'statement'
  506. and the next one.  If we are already between statements, move forward one 
  507. more."
  508.   (unwind-protect
  509.       ;; Because "\b" doesn't work with "symbol-chars" we temporarily
  510.       ;; install a new syntax table and restore the old one when done
  511.       (progn
  512.     (set-syntax-table dylan-indent-syntax-table)
  513.     (dylan-skip-whitespace-forward)
  514.     (let* ((dot (point)))
  515.       ;; skip over "separator words"
  516.       (if (looking-at separator-word-pattern)
  517.           (if (not (looking-at "exception\\|elseif"))
  518.              (forward-word 1)
  519.                (goto-char (match-end 0))
  520.                (condition-case nil (forward-list 1)
  521.              (error nil))))
  522.       (cond ((not (dylan-find-end t in-case no-commas))
  523.          (if (look-back "\\(define\\|local\\)[ \t]+")    ; hack
  524.              (goto-char (match-beginning 0))))
  525.         (t)))
  526.     (cond ((looking-at "[,;]$") (forward-char))
  527.           ((looking-at "=>") (forward-word 1))))
  528.     (set-syntax-table dylan-mode-syntax-table)))
  529.  
  530. (defun dylan-end-of-form ()
  531.   "Finds the end of the innermost 'statement' which contains or begins
  532. at the current point."
  533.   (interactive)
  534.   (forward-dylan-statement))
  535.  
  536. (defun indent-if-continuation (term-char line-start block-start
  537.                      &optional in-case in-paren)
  538.   (save-excursion
  539.     (goto-char line-start)
  540.     (let ((arrow (and dylan-outdent-arrows (looking-at "=>"))))
  541.       (dylan-skip-whitespace-backward)
  542.       (if (look-back "finally$")    ; special case -- this one is tricky
  543.       0                ; because "for" can have empty bodies
  544.     (let ((real-start (point)))
  545.       (backward-dylan-statement in-case)
  546.       (dylan-skip-whitespace-forward)
  547.       (cond ((and (= block-start 0) (not (looking-at "define")))
  548.          0)            ; special case for beginning of file
  549.         ((= real-start block-start) 0)
  550.         ((< (point) block-start)
  551.          (+ dylan-indent (if (and arrow (not in-case)) -3 0)))
  552.         ((< (save-excursion
  553.               (forward-dylan-statement in-case
  554.                            (equal term-char ";"))
  555.               (point)) line-start)
  556.          0)
  557.         ;; Give continuations of generic functions extra
  558.         ;; indentation to match what happens with method
  559.         ;; declarations.  This is an odd special case, but some
  560.         ;; folks like it.  If you don't, comment out the next 3
  561.         ;; lines.
  562.         ((looking-at
  563.           "define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t]+generic")
  564.          (+ dylan-indent dylan-indent (if arrow -3 0)))
  565.         (t dylan-indent)))))))
  566.  
  567. (defun dylan-indent-line (&optional ignore-case extra-indent)
  568.   "Indents a line of dylan code according to its nesting."
  569.   ;; The "ignore-case" and "extra-indent" vars are used for recursive
  570.   ;; calls so that the special code for handling case statements won't
  571.   ;; recurse infinitely.
  572.   (interactive)
  573.   (setq extra-indent (or extra-indent 0))
  574.   (unwind-protect
  575.       (save-excursion
  576.     ;; Because "\b" doesn't work with "symbol-chars" we temporarily
  577.     ;; install a new syntax table and restore the old one when done
  578.     (set-syntax-table dylan-indent-syntax-table)
  579.     (beginning-of-line)
  580.     (delete-horizontal-space)
  581.     (let* ((body-start)        ; beginning of "body" of enclosing
  582.                     ; compound statement
  583.            (was-paren)        ; t if in parenthesized expr.
  584.            (in-case)        ; t if in "case" or "select" stmt
  585.            (block-indent        ; indentation of enclosing comp. stmt
  586.         (save-excursion
  587.           (if (not (dylan-find-keyword))
  588.               nil
  589.             (and (looking-at "method")
  590.              (look-back "define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t]+$")
  591.              (goto-char (match-beginning 0)))
  592.             (and (looking-at "[[({]") (setq was-paren t))
  593.             (and (looking-at "select\\|case") (setq in-case t))
  594.             (setq body-start (find-body-start dyl-start-expressions))
  595.             (+ (current-column) extra-indent))))
  596.            (indent            ; correct indentation for this line
  597.         (cond ((not block-indent)
  598.                (indent-if-continuation ";" (point) 0))
  599.               ;; some keywords line up with start of comp. stmt 
  600.               ((looking-at separator-word-pattern) block-indent)
  601.               ;; end keywords line up with start of comp. stmt 
  602.               ((looking-at dyl-end-keyword-pattern) block-indent)
  603.               ;; parenthesized expressions (separated by commas)
  604.               (in-case
  605.                ; if the line is blank, we pick an arbitrary
  606.                ; indentation for now.  We judge the "proper"
  607.                ; indentation by how the statement is punctuated once
  608.                ; it is finished
  609.                (cond ((looking-at "^$")
  610.                   (if (save-excursion
  611.                     ; Look for end of prev statement.  This
  612.                     ; is hairier than it should be because
  613.                     ; we may be at the end of the buffer
  614.                     (let ((dot (point)))
  615.                       (forward-dylan-statement t)
  616.                       (dylan-skip-whitespace-backward)
  617.                       (if (> (point) dot)
  618.                       (backward-dylan-statement t))
  619.                       (look-back ";$\\|=>$")))
  620.                   (+ block-indent dylan-indent dylan-indent
  621.                      (indent-if-continuation "," (point)
  622.                                  body-start t))
  623.                 (+ block-indent dylan-indent 
  624.                    (indent-if-continuation "," (point)
  625.                                body-start t))))
  626.                  ((save-excursion
  627.                 (forward-dylan-statement t)
  628.                 (look-back ",$\\|=>$"))
  629.                   (+ block-indent dylan-indent 
  630.                  (indent-if-continuation "," (point)
  631.                              body-start t)))
  632.                  (t (+ block-indent dylan-indent dylan-indent
  633.                    (indent-if-continuation "," (point)
  634.                                body-start t)))))
  635.               (was-paren (+ block-indent 1
  636.                     (indent-if-continuation "," (point)
  637.                                 body-start)))
  638.               ;; statements (separated by semi-colons)
  639.               (t (+ block-indent dylan-indent
  640.                 (indent-if-continuation ";" (point)
  641.                             body-start))))))
  642.       (indent-to-column indent)))
  643.     ;; put the cursor where the user is likely to want it.
  644.     (and (= (current-column) 0) (skip-chars-forward " \t"))
  645.     (set-syntax-table dylan-mode-syntax-table)))
  646.  
  647. (defun in-case ()
  648.   "Checks to see whether we are immediately nested in a 'case' or 'select'
  649. statement.  Is used to provide special re-indentation for ',', ';', and '=>'."
  650.   (save-excursion
  651.     (dylan-find-keyword)
  652.     (looking-at "case\\|select")))
  653.  
  654. (defun reindent-line ()
  655.   (interactive)
  656.   (save-excursion (funcall indent-line-function)))
  657.  
  658. (defun dylan-newline-and-indent ()
  659.   (interactive)
  660.   (expand-abbrev)
  661.   (newline-and-indent))
  662.  
  663. (if (and (boundp 'running-lemacs) running-lemacs)
  664.     (defun this-command-chars ()
  665.       (events-to-keys (this-command-keys)))
  666.   (defun this-command-chars ()
  667.     (this-command-keys)))
  668.  
  669. (defun dylan-insert-and-indent ()
  670.   "Make ';' and ',' do re-indentation for case statements."
  671.   (interactive)
  672.   (self-insert-command 1)
  673.   (if (in-case)
  674.       (save-excursion
  675.     ;; These things are finicky around EOF, so use "point-marker" instead
  676.     ;; of "point" so that re-indentations won't yield infinite loops
  677.     (let ((dot (point-marker)))
  678.       (backward-dylan-statement t)
  679.       (dylan-skip-whitespace-forward)
  680.       (while (< (point) (marker-position dot))
  681.         (funcall indent-line-function)
  682.         (forward-line 1))))))
  683.  
  684. (defun dylan-arrow-insert ()
  685.   "Make '=>' do re-indentation for case statements and function declarations."
  686.   (interactive)
  687.   (if (not (= (preceding-char) ?=))
  688.       (self-insert-command 1)
  689.     (self-insert-command 1)
  690.     (save-excursion
  691.       (if (in-case)
  692.       (let ((dot (point-marker)))
  693.         (backward-dylan-statement t)
  694.         (dylan-skip-whitespace-forward)
  695.         (while (< (point) (marker-position dot))
  696.           (funcall indent-line-function)
  697.           (forward-line 1)))
  698.     (funcall indent-line-function)))))
  699.  
  700.  
  701. ;;; This intensely DWIMish function tries to insert whatever text is needed to
  702. ;;; finish off the enclosing indentation context.
  703. (defun dylan-insert-block-end ()
  704.   "Insert whatever text is needed to finish off the enclosing indentation
  705. context (i.e. \"block\").  Makes educated guesses about whether newlines
  706. and closing punctuation are needed."
  707.   (interactive)
  708.   (let* ((here (point))
  709.      (terminator)
  710.      (need-newline)
  711.      (str
  712.       (unwind-protect
  713.           (save-excursion
  714.         ;; Because "\b" doesn't work with "symbol-chars" we temporarily
  715.         ;; install a new syntax table and restore the old one when done
  716.         (set-syntax-table dylan-indent-syntax-table)
  717.         (if (not (dylan-find-keyword))
  718.             (error "No nesting block."))
  719.         ; need newline if multi-line block and not "("
  720.         (setq need-newline (not (or (looking-at "[[({]")
  721.                         (save-excursion (end-of-line)
  722.                                 (>= (point) here)))))
  723.         (setq terminator
  724.               (save-excursion
  725.             (cond ((not (dylan-find-keyword)) ";")
  726.                   ((looking-at "[[({]") "")
  727.                   (t ";"))))
  728.         (if (looking-at "define\\([ \t\n]+\\(sealed\\|open\\|abstract\\|concrete\\|primary\\|free\\)\\)*[ \t]*")    ; find the actual word
  729.             (goto-char (match-end 0)))
  730.         (if (looking-at
  731.              "\\(sealed\\|open\\|abstract\\|concrete\\|primary\\|free\\)[ \t]*")
  732.             (goto-char (match-end 0)))
  733.         (cond ((looking-at "begin") (concat " end" terminator))
  734.               ((looking-at "\\[") "]")
  735.               ((looking-at "(") ")")
  736.               ((looking-at "{") "}")
  737.               ((or (looking-at "\\(method\\|class\\)\\([ \t]+\\w+\\)?")
  738.                (looking-at "\\(library\\|module\\)[ \t]+\\w+")
  739.                (looking-at "\\w+"))
  740.                (concat " end "
  741.                    (buffer-substring (match-beginning 0)
  742.                          (match-end 0))
  743.                    terminator))
  744.               (t (concat " end" terminator))))
  745.         (set-syntax-table dylan-mode-syntax-table))))
  746.     (if need-newline
  747.     (progn
  748.       (beginning-of-line)
  749.       (if (looking-at "[ \t]*$")
  750.           (delete-horizontal-space)
  751.         (end-of-line)
  752.         (newline))))
  753.     (let* ((start (point))
  754.        (end (progn (insert str) (point))))
  755.       (goto-char start)
  756.       (while (re-search-forward "[ \t\n]+" end t)
  757.     (replace-match " "))
  758.       (goto-char end)
  759.       (reindent-line))))
  760.  
  761. (defun dylan-mode ()
  762.   "Major mode for editing dylan programs.
  763.  
  764. Tab and newline do dylan specific indentation.
  765. '//' comments are handled completely and '/*' comments marginally.
  766. Supports font-lock-mode under emacs 19 and lucid emacs.
  767.  
  768. The following bindings are available traversing and editing dylan code:
  769.   \\[dylan-beginning-of-form]
  770.     Moves to the beginning of the current 'statement'.
  771.   \\[dylan-end-of-form]
  772.     Moves to the end of the current 'statement'.
  773.   \\[dylan-insert-block-end]
  774.     Insert the appropriate text to close the current 'block'.
  775.  
  776. The default indentation level is controlled by the 'dylan-indent' variable.
  777. The default is 2 spaces.
  778.  
  779. By default, the mode uses a special indentation level for function return 
  780. declarations which lines up parameter declarations with return type 
  781. declarations.  This special feature may be turned off by setting 
  782. 'dylan-outdent-arrows' to nil."
  783.   (interactive)
  784.   (abbrev-mode 1)
  785.   (use-local-map dylan-mode-map)
  786.   (setq major-mode 'dylan-mode)
  787.   (setq mode-name "dylan")
  788.   (setq local-abbrev-table dylan-mode-abbrev-table)
  789.   ;; Use value appropriate for font-lock-mode now.  Reset after running hooks.
  790.   (set-syntax-table dylan-indent-syntax-table)
  791.   (make-local-variable 'indent-line-function)
  792.   (setq indent-line-function 'dylan-indent-line)
  793.   (make-local-variable 'comment-start)
  794.   (setq comment-start "// ")
  795.   (make-local-variable 'comment-start-skip)
  796.   (setq comment-start-skip "//+[ \t]*\\|/\\*[ \t]*")
  797.   (make-local-variable 'parse-sexp-ignore-comments)
  798.   (setq parse-sexp-ignore-comments t)
  799.   (setq local-abbrev-table dylan-mode-abbrev-table)
  800.   (make-local-variable 'after-change-function)
  801.   (setq after-change-function nil)
  802.   (run-hooks 'dylan-mode-hook)
  803.   ;; This is the table the user should always see, even though the indent and
  804.   ;; font lock code both reset it temporarily.
  805.   (set-syntax-table dylan-mode-syntax-table))
  806.  
  807. (if (fboundp 'font-lock-mode)
  808.     (progn
  809.       ;; We must use the "indentation" syntax table when doing font-lock
  810.       ;; processing.  This ugly hack should do the right thing, even if
  811.       ;; font-lock mode complains if you try to turn it off later.
  812.       (defvar old-after-change-function nil
  813.     "Used to modify the behavior of font-lock-mode.")
  814.       (defun dm-after-change-function (&rest args)
  815.     (let ((old-syntax-table (syntax-table)))
  816.       (unwind-protect
  817.           (progn
  818.         (set-syntax-table dylan-indent-syntax-table)
  819.         (apply old-after-change-function args))
  820.         (set-syntax-table old-syntax-table))))
  821.  
  822.       ;; See font-lock-mode for details.  It's ugly, but it works.
  823.       (setq dylan-font-lock-keywords
  824.         (list dyl-end-keyword-pattern
  825.           dyl-keyword-pattern
  826.           separator-word-pattern
  827.           "[-_a-zA-Z?!*@<>$%]+:"
  828.           "#rest\\|#key\\|#next"
  829.           dyl-other-pattern
  830.           '("\\b\\(define\\([ \t\n]+\\(sealed\\|open\\|abstract\\|concrete\\primary\\|open\\)\\)*[ \t]+\\(class\\|method\\|generic\\|variable\\|constant\\)\\)\\b[ \t]+\\(\\w+\\)" 1
  831.             font-lock-keyword-face t)
  832.           '("\\b\\(define\\([ \t\n]+\\(sealed\\|open\\|abstract\\|concrete\\|primary\\|open\\)\\)*[ \t]+\\(class\\|method\\|generic\\|variable\\|constant\\)\\)\\b[ \t]+\\(\\(\\s_\\|\\w\\)+\\)" 5
  833.             font-lock-function-name-face)
  834.           '("\\bend[ \t]+\\w*\\b[ \t]+\\(\\(\\s_\\|\\w\\)+\\)" 1
  835.             font-lock-function-name-face)
  836.           '("\\b\\(\\(\\s_\\|\\w\\)*\\)(" 1 font-lock-function-name-face)))
  837.       ;; More hacks to magically switch syntax tables as necessary
  838.       (add-hook
  839.        'font-lock-mode-hook
  840.        '(lambda ()
  841.       (if (not (eq major-mode 'dylan-mode))
  842.           nil
  843.         (setq font-lock-keywords dylan-font-lock-keywords)
  844.         (make-variable-buffer-local 'old-after-change-function)
  845.         (setq old-after-change-function 'font-lock-after-change-function)
  846.         (make-variable-buffer-local 'after-change-function)
  847.         (setq after-change-function 'dm-after-change-function))))))
  848.